home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MENU_UTL / LIBPAS / LIBRARY.PAS next >
Pascal/Delphi Source File  |  1991-02-17  |  20KB  |  687 lines
  1. unit NewLib2;
  2. interface
  3. uses crt,dos;
  4.  
  5. const
  6.  MaxFiles = 30;
  7.  MaxChoices = 8;
  8.  
  9. type
  10.  STRING79 = string[79];
  11.  TOGGLE_REC = record
  12.    NUM_CHOICES: integer;
  13.    STRINGS    : array [0..8] of STRING79;
  14.    LOCATIONS  : array [0..8] of integer;
  15.  end;
  16.  RESPONSE_TYPE = (NO_RESPONSE, ARROW, KEYBOARD, RETURN);
  17.  MOVEMENT = (NONE, LEFT, RIGHT, UP, DOWN);
  18.  FnameType = string[12];
  19.  FileListType = array[1..MaxFiles] of FnameType;
  20.  ScrMenuRec = record
  21.    Selection  : array[1..MaxChoices] of STRING79;
  22.    Descripts  : array[1..MaxChoices,1..3] of STRING79;
  23.  end;
  24.  ScrMenuType = object
  25.    NumChoices : integer;
  26.    Last       : integer;
  27.    Line, Col  : integer;
  28.    MenuData   : ScrMenuRec;
  29.    procedure Setup(MData: ScrMenuRec);
  30.    function  GetChoice : integer;
  31.  end;
  32.  
  33.  
  34. procedure Set_Video (ATTRIBUTE: integer);
  35. procedure Put_String (OUT_STRING: STRING79; LINE, COL, ATTRIB: integer);
  36. procedure Put_Text (OUT_STRING: STRING79; LINE, COL: integer);
  37. procedure Put_Colored_Text (OUT_STRING: STRING79;
  38.                             LINE, COL, TXTCLR, BKGCLR: integer);
  39. procedure Put_Centered_String (OUT_STRING: STRING79; LINE, ATTRIB: integer);
  40. procedure Put_Centered_Text (OUT_STRING: STRING79; LINE: integer);
  41. procedure Put_Error (OUT_STRING: STRING79; LINE, COL: integer);
  42. procedure End_Erase (LINE, COL: integer);
  43. procedure Put_Prompt (OUT_STRING: STRING79; LINE, COL: integer);
  44. procedure Get_Response (var RESPONSE    : RESPONSE_TYPE;
  45.                         var DIRECTION   : MOVEMENT;
  46.                         var KEY_RESPONSE: char);
  47. procedure Get_String (var IN_STRING: STRING79;
  48.                       LINE, COL, ATTRIB, STR_LENGTH: integer);
  49. procedure Get_Integer (var NUMBER: integer;
  50.                        LINE, COL, ATTRIB, NUM_LENGTH: integer);
  51. procedure Get_Prompted_String (var IN_STRING: STRING79;
  52.                           INATTR, STR_LENGTH: integer;
  53.                                      STRDESC: STRING79;
  54.                            DESCLINE, DESCCOL: integer;
  55.                                       PROMPT: STRING79;
  56.                                PRLINE, PRCOL: integer);
  57. procedure Put_1col_Toggle (TOGGLE: TOGGLE_REC; COL, CHOICE: integer);
  58. procedure Get_1col_Toggle (    TOGGLE: TOGGLE_REC;
  59.                                   COL: integer;
  60.                            var CHOICE: integer;
  61.                                PROMPT: STRING79;
  62.                         PRLINE, PRCOL: integer);
  63. procedure Box_Text (TopX, TopY, BotX, BotY, BoxColor: integer);
  64. procedure Solid_Box (TopX, TopY, BotX, BotY, BoxColor: integer);
  65. procedure swap_fnames(var A,B: FnameType);
  66. procedure FileSort(var fname: FileListType; NumFiles: integer);
  67. function  Get_Files_Toggle (choices: FileListType;
  68.                             NumChoices,NumRows,row,col:integer): FnameType;
  69. function Get_File_Menu(mask: string;NumRows,Row,Col: integer): FnameType;
  70.  
  71.  
  72. {-------------------------------------------------------------------------}
  73. implementation
  74.  
  75. procedure Set_Video (ATTRIBUTE: integer);
  76. {
  77. NOTES:
  78.       The attribute code, based on bits, is as follows:
  79.           0 - normal video         1 - reverse video
  80.           2 - bold video           3 - reverse and bold
  81.           4 - blinking video       5 - reverse and blinking
  82.           6 - bold and blinking    7 - reverse, bold, and blinking
  83. }
  84.  
  85. var
  86.    BLINKING,
  87.    BOLD: integer;
  88.  
  89. begin
  90.    BLINKING := (ATTRIBUTE AND 4)*4;
  91.    if (ATTRIBUTE AND 1) = 1 then
  92.       begin
  93.          BOLD := (ATTRIBUTE AND 2)*7;
  94.          Textcolor (1 + BLINKING + BOLD);
  95.          TextBackground (3);
  96.       end
  97.    else
  98.       begin
  99.          BOLD := (ATTRIBUTE AND 2)*5 DIV 2;
  100.          Textcolor (7 + BLINKING + BOLD);
  101.          TextBackground (0);
  102.       end;
  103. end;
  104.  
  105. {-------------------------------------------------------------------------}
  106.  
  107. procedure Put_String (OUT_STRING: STRING79;
  108.                      LINE, COL, ATTRIB: integer);
  109.  
  110. begin
  111.    Set_Video (ATTRIB);
  112.    GotoXY (COL, LINE);
  113.    write (OUT_STRING);
  114.    Set_Video (0);
  115. end;
  116.  
  117. {-------------------------------------------------------------------------}
  118.  
  119. procedure Put_Text (OUT_STRING: STRING79;
  120.                    LINE, COL: integer);
  121.  
  122. begin
  123.    GotoXY (COL, LINE);
  124.    write (OUT_STRING);
  125. end;
  126.  
  127. {-------------------------------------------------------------------------}
  128.  
  129. procedure Put_Colored_Text (OUT_STRING: STRING79;
  130.                            LINE, COL, TXTCLR, BKGCLR: integer);
  131.  
  132. begin
  133.    GotoXY (COL, LINE);
  134.    TextColor (TXTCLR);
  135.    TextBackground (BKGCLR);
  136.    write (OUT_STRING);
  137. end;
  138.  
  139. {-------------------------------------------------------------------------}
  140.  
  141. procedure Put_Centered_String (OUT_STRING: STRING79;
  142.                               LINE, ATTRIB: integer);
  143.  
  144. begin
  145.    Put_String (OUT_STRING, LINE, 40-Length(OUT_STRING) div 2, ATTRIB);
  146. end;
  147.  
  148. {-------------------------------------------------------------------------}
  149.  
  150. procedure Put_Centered_Text (OUT_STRING: STRING79;
  151.                             LINE: integer);
  152.  
  153. begin
  154.    Put_Text (OUT_STRING, LINE, 40-Length(OUT_STRING) div 2);
  155. end;
  156.  
  157. {-------------------------------------------------------------------------}
  158.  
  159. procedure Put_Error (OUT_STRING: STRING79;
  160.                      LINE, COL: integer);
  161.  
  162. var
  163.    ANY_CHAR : char;
  164.  
  165. begin
  166. repeat
  167.    Put_String (OUT_STRING, LINE, COL, 6);
  168. until keypressed = true;
  169. end;
  170.  
  171. {-------------------------------------------------------------------------}
  172.  
  173. procedure End_Erase (LINE, COL: integer);
  174.  
  175. begin
  176.    GotoXY (COL, LINE);
  177.    ClrEol;
  178. end;
  179.  
  180. {-------------------------------------------------------------------------}
  181.  
  182. procedure Put_Prompt (OUT_STRING: STRING79;
  183.                      LINE, COL: integer);
  184.  
  185. begin
  186.    GotoXY (COL, LINE);
  187.    ClrEol;
  188.    Put_String (OUT_STRING, LINE, COL, 3);
  189. end;
  190.  
  191. {-------------------------------------------------------------------------}
  192.  
  193.  
  194. procedure Get_Response (var RESPONSE    : RESPONSE_TYPE;
  195.                         var DIRECTION   : MOVEMENT;
  196.                         var KEY_RESPONSE: char);
  197.  
  198. const
  199.    BELL            = 7;
  200.    CARRIAGE_RETURN = 13;
  201.    ESCAPE          = 27;
  202.    RIGHT_ARROW     = 77;
  203.    LEFT_ARROW      = 75;
  204.    DOWN_ARROW      = 80;
  205.    UP_ARROW        = 72;
  206.  
  207. var
  208.    IN_CHAR: char;
  209.  
  210. begin
  211.    RESPONSE := NO_RESPONSE;
  212.    DIRECTION := NONE;
  213.    KEY_RESPONSE := ' ';
  214.    repeat
  215.       IN_CHAR := ReadKey;
  216.       if IN_CHAR = #0 then
  217.       begin
  218.          RESPONSE := ARROW;
  219.          IN_CHAR := ReadKey;
  220.          if Ord(IN_CHAR) = LEFT_ARROW then
  221.             DIRECTION := LEFT
  222.          else if Ord(IN_CHAR) = RIGHT_ARROW then
  223.             DIRECTION := RIGHT
  224.          else if Ord(IN_CHAR) = DOWN_ARROW then
  225.             DIRECTION := DOWN
  226.          else if Ord(IN_CHAR) = UP_ARROW then
  227.             DIRECTION := UP
  228.          else
  229.          begin
  230.             RESPONSE := NO_RESPONSE;
  231.             write (Chr(BELL));
  232.          end
  233.       end
  234.       else if Ord(IN_CHAR) = CARRIAGE_RETURN then
  235.          RESPONSE := RETURN
  236.       else
  237.       begin
  238.          RESPONSE := KEYBOARD;
  239.          KEY_RESPONSE := UpCase (IN_CHAR);
  240.       end;
  241.    until RESPONSE <> NO_RESPONSE;
  242. end;
  243.  
  244. {-------------------------------------------------------------------------}
  245.  
  246. procedure Get_String (var IN_STRING: STRING79;
  247.                      LINE, COL, ATTRIB, STR_LENGTH: integer);
  248.  
  249. var
  250.    OLDSTR : STRING79;
  251.    IN_CHAR: char;
  252.    I      : integer;
  253.  
  254. const
  255.    BELL            = 7;
  256.    BACK_SPACE      = 8;
  257.    CARRIAGE_RETURN = 13;
  258.    ESCAPE          = 27;
  259.    RIGHT_ARROW     = 77;
  260.  
  261. begin
  262.    OLDSTR := IN_STRING;
  263.    Put_String (IN_STRING, LINE, COL, ATTRIB);
  264.    for I := Length(IN_STRING) to STR_LENGTH-1 do
  265.       Put_String (' ', LINE, COL + I, ATTRIB);
  266.    GotoXY (COL, LINE);
  267.    IN_CHAR := ReadKey;
  268.    if Ord(IN_CHAR) <> CARRIAGE_RETURN then
  269.       IN_STRING := '';
  270.    while Ord(IN_CHAR) <> CARRIAGE_RETURN do
  271.    begin
  272.       if Ord(IN_CHAR) = BACK_SPACE then
  273.       begin
  274.          if Length(IN_STRING) > 0 then
  275.          begin
  276.             IN_STRING[0] := Chr(Length(IN_STRING)-1);
  277.             write (Chr(BACK_SPACE));
  278.             write (' ');
  279.             write (Chr(BACK_SPACE));
  280.          end;
  281.       end  { if BACK_SPACE }
  282.       else if IN_CHAR = #0 then
  283.       begin
  284.          IN_CHAR := ReadKey;
  285.          if Ord(IN_CHAR) = RIGHT_ARROW then
  286.          begin
  287.             if Length(OLDSTR) > Length(IN_STRING) then
  288.             begin
  289.                IN_STRING[0] := Chr(Length(IN_STRING) + 1);
  290.                IN_CHAR := OLDSTR[Ord(IN_STRING[0])];
  291.                IN_STRING[Ord(IN_STRING[0])] := IN_CHAR;
  292.                write (IN_CHAR);
  293.             end
  294.          end      { RIGHT_ARROW }
  295.             else
  296.                write (Chr(BELL));
  297.       end   { IN_CHAR = #0 }
  298.    else if Length (IN_STRING) < STR_LENGTH then
  299.       begin
  300.          IN_STRING[0] := Chr(Length(IN_STRING) + 1);
  301.          IN_STRING[Ord(IN_STRING[0])] := IN_CHAR;
  302.          TextColor (15);
  303.          TextBackGround (11);
  304.          write (IN_CHAR);
  305.       end
  306.       else
  307.          write (Chr(BELL));
  308.       IN_CHAR := ReadKey;
  309.    end;
  310.    Put_String (IN_STRING, LINE, COL, ATTRIB);
  311.    for I := Length(IN_STRING) to STR_LENGTH - 1 do
  312.       Put_String (' ', LINE, COL+I, ATTRIB);
  313. end;
  314.  
  315. {-------------------------------------------------------------------------}
  316.  
  317. procedure Get_Integer (var NUMBER: integer;
  318.                       LINE, COL, ATTRIB, NUM_LENGTH: integer);
  319.  
  320. const
  321.    BELL = 7;
  322.  
  323. var
  324.    VALCODE      : integer;
  325.    ORIGINAL_STR,
  326.    TEMP_STR     : STRING79;
  327.    TEMP_INT     : integer;
  328.  
  329. begin
  330.    Str (NUMBER:NUM_LENGTH, ORIGINAL_STR);
  331.    repeat
  332.       TEMP_STR := ORIGINAL_STR;
  333.       Get_String (TEMP_STR, LINE, COL, ATTRIB, NUM_LENGTH);
  334.       while TEMP_STR[1] = ' ' do
  335.          TEMP_STR := Copy (TEMP_STR, 2, Length (TEMP_STR));
  336.       Val (TEMP_STR, TEMP_INT, VALCODE);
  337.       if (VALCODE <> 0) then
  338.          write (Chr(BELL));
  339.    until VALCODE = 0;
  340.    NUMBER := TEMP_INT;
  341.    Str (NUMBER:NUM_LENGTH, TEMP_STR);
  342.    Put_String (TEMP_STR, LINE, COL, ATTRIB);
  343. end;
  344.  
  345. {-------------------------------------------------------------------------}
  346.  
  347. procedure Get_Prompted_String (var IN_STRING: STRING79;
  348.                           INATTR, STR_LENGTH: integer;
  349.                                      STRDESC: STRING79;
  350.                            DESCLINE, DESCCOL: integer;
  351.                                       PROMPT: STRING79;
  352.                                PRLINE, PRCOL: integer);
  353.  
  354. begin
  355.    Put_String (STRDESC, DESCLINE, DESCCOL, 2);
  356.    Put_Prompt (PROMPT, PRLINE, PRCOL);
  357.    Get_String (IN_STRING, DESCLINE, DESCCOL + Length(STRDESC),
  358.                INATTR, STR_LENGTH);
  359.    Put_String (STRDESC, DESCLINE, DESCCOL, 0);
  360. end;
  361.  
  362. {-------------------------------------------------------------------------}
  363.  
  364. procedure Put_1col_Toggle (TOGGLE: TOGGLE_REC;
  365.                            COL, CHOICE: integer);
  366.  
  367. var
  368.    I: integer;
  369.  
  370. begin
  371.    with TOGGLE do
  372.    begin
  373.       Put_String (STRINGS[0], LOCATIONS[0], COL, 0);
  374.       for I := 1 to NUM_CHOICES do
  375.          Put_String (STRINGS[I], LOCATIONS[I], COL, 0);
  376.       if (CHOICE <1) or (CHOICE > NUM_CHOICES) then
  377.          CHOICE := 1;
  378.       Put_String (STRINGS[CHOICE], LOCATIONS[CHOICE], COL, 1);
  379.    end;
  380. end;
  381.  
  382. {-------------------------------------------------------------------------}
  383.  
  384. procedure Get_1col_Toggle (    TOGGLE: TOGGLE_REC;
  385.                                   COL: integer;
  386.                            var CHOICE: integer;
  387.                                PROMPT: STRING79;
  388.                         PRLINE, PRCOL: integer);
  389.  
  390. var
  391.    RESP : RESPONSE_TYPE;
  392.    DIR  : MOVEMENT;
  393.    KEYCH: char;
  394.  
  395. begin
  396.    Put_Colored_Text (PROMPT, PRLINE, PRCOL, 15, 0);
  397.    with TOGGLE do
  398.    begin
  399.       Put_String (STRINGS[0], LOCATIONS[0], COL, 2);
  400.       if (CHOICE < 1) or (CHOICE > NUM_CHOICES) then
  401.          CHOICE := 1;
  402.       Put_String (STRINGS[CHOICE], LOCATIONS[CHOICE], COL, 1);
  403.       RESP := NO_RESPONSE;
  404.       while RESP <> RETURN do
  405.       begin
  406.          Get_Response (RESP, DIR, KEYCH);
  407.          case RESP of
  408.             ARROW:
  409.                if DIR = UP then
  410.                begin
  411.                   Put_String (STRINGS[CHOICE], LOCATIONS[CHOICE], COL, 0);
  412.                   if CHOICE = 1 then
  413.                      CHOICE := NUM_CHOICES
  414.                   else
  415.                      CHOICE := CHOICE - 1;
  416.                   Put_String (STRINGS[CHOICE], LOCATIONS[CHOICE], COL, 1);
  417.                end
  418.                else if DIR = DOWN then
  419.                begin
  420.                   Put_String (STRINGS[CHOICE], LOCATIONS[CHOICE], COL, 0);
  421.                   if CHOICE = NUM_CHOICES then
  422.                      CHOICE := 1
  423.                   else
  424.                      CHOICE := CHOICE + 1;
  425.                   Put_String (STRINGS[CHOICE], LOCATIONS[CHOICE], COL, 1);
  426.                end
  427.             else
  428.                write (Chr(7));
  429.             KEYBOARD:  write (Chr(7));
  430.             RETURN: ;
  431.          end;
  432.       end; {while}
  433.    Put_String (STRINGS[0], LOCATIONS[0], COL, 0);
  434.    end;
  435. end;
  436.  
  437. {-------------------------------------------------------------------------}
  438.  
  439. procedure Box_Text (TopX, TopY, BotX, BotY, BoxColor: integer);
  440.  
  441. var
  442.    i     : integer;
  443.    width : integer;
  444.    height: integer;
  445.  
  446. begin
  447.    TextBackGround (BoxColor);
  448.    height := BotY - TopY;
  449.    width := BotX - TopX;
  450.    GotoXY (TopX, TopY);
  451.    for i := 1 to width do
  452.       write (' ');
  453.    for i := TopY to (TopY+height) do
  454.       begin
  455.          GotoXY (TopX, i);
  456.          write ('  ');
  457.          GotoXY (BotX-1, i);
  458.          write ('  ');
  459.       end;
  460.    GotoXY (TopX, BotY);
  461.    for i := 1 to width do
  462.       write (' ');
  463. end;
  464.  
  465. {-------------------------------------------------------------------------}
  466.  
  467. procedure Solid_Box (TopX, TopY, BotX, BotY, BoxColor: integer);
  468.  
  469. var
  470.    i     : integer;
  471.    j     : integer;
  472.    width : integer;
  473.  
  474. begin
  475.    TextBackGround (BoxColor);
  476.    GotoXY (TopX, TopY);
  477.    width := BotX - TopX;
  478.    for i := TopY to BotY do
  479.       begin
  480.          for j := 1 to width do
  481.             write (' ');
  482.          GotoXY (TopX, i);
  483.       end;
  484. end;
  485.  
  486. procedure swap_fnames(var A,B: FnameType);
  487. var
  488.   Temp : FnameType;
  489. begin
  490.   Temp := A;
  491.   A := B;
  492.   B := Temp;
  493. end;
  494.  
  495. procedure FileSort(var fname: FileListType;NumFiles: integer);
  496. var
  497.   i,j : integer;
  498. begin
  499.   for j := NumFiles downto 2 do
  500.     for i := 1 to j-1 do
  501.       if fname[i]>fname[j] then
  502.         swap_fnames(fname[i],fname[j]);
  503. end;
  504.  
  505. function Get_Files_Toggle (choices:FileListType;
  506.                            NumChoices,NumRows,row,col:integer): FnameType;
  507. var
  508.   i,r   : integer;
  509.   Resp  : Response_Type;
  510.   dir   : movement;
  511.   keych : char;
  512.  
  513. procedure Put_Files_Toggle (choices: FileListType; First,NumRows,row,col: integer);
  514. var
  515.   i : integer;
  516. begin
  517.   for i := 0 to NumRows-1 do
  518.     Put_string (choices[First+i],row+i,col,0);
  519. end;
  520.  
  521. procedure Padnames;
  522. var
  523.   i,p : integer;
  524. begin
  525.   for i := 1 to MaxFiles do
  526.     begin
  527.       p := 12-length(choices[i]);
  528.       while p>0 do
  529.         begin
  530.           choices[i] := choices[i]+' ';
  531.           p := p-1;
  532.         end;
  533.     end;
  534. end;
  535.  
  536. begin
  537.   Padnames;
  538.   i := 1;
  539.   r := 1;
  540.   if NumChoices < NumRows then
  541.     NumRows := NumChoices;
  542.   Put_Files_Toggle (choices,1,NumRows,row,col);
  543.   Get_Files_Toggle := choices[i];
  544.   Put_string(choices[i],row,col,1);
  545.   resp := No_Response;
  546.   while resp <> Return do
  547.     begin
  548.       Get_response (resp,dir,keych);
  549.       case resp of
  550.         ARROW: if dir=UP then
  551.                  begin
  552.                    Put_string(choices[i],row+r-1,col,0);
  553.                    if i=1 then
  554.                      begin
  555.                        i := NumChoices;
  556.                        r := NumRows;
  557.                        Put_Files_Toggle(choices,i+1-NumRows,NumRows,row,col);
  558.                      end
  559.                    else if r=1 then
  560.                      begin
  561.                        i := i-1;
  562.                        Put_Files_Toggle(choices,i,NumRows,row,col);
  563.                      end
  564.                    else
  565.                      begin
  566.                        i := i-1;
  567.                        r := r-1;
  568.                      end;
  569.                    Put_string(choices[i],row+r-1,col,1);
  570.                  end
  571.                else if dir=DOWN then
  572.                  begin
  573.                    Put_string(choices[i],row+r-1,col,0);
  574.                    if i=NumChoices then
  575.                      begin
  576.                        i := 1;
  577.                        r := 1;
  578.                        Put_Files_Toggle(choices,i,NumRows,row,col);
  579.                      end
  580.                    else if r=NumRows then
  581.                      begin
  582.                        i := i+1;
  583.                        Put_Files_Toggle(choices,i+1-NumRows,NumRows,row,col);
  584.                      end
  585.                    else
  586.                      begin
  587.                        i := i+1;
  588.                        r := r+1;
  589.                      end;
  590.                    Put_string(choices[i],row+r-1,col,1);
  591.                  end
  592.                else
  593.                  write (chr(7));
  594.         KEYBOARD:  write (chr(7));
  595.         end; { case }
  596.     end;
  597.   Get_Files_toggle := choices[i];
  598. end;
  599.  
  600. function Get_File_Menu(mask: string;NumRows,Row,Col: integer): FnameType;
  601. var
  602.   i : integer;
  603.   NumFiles : integer;
  604.   FileList : FileListType;
  605.   dirinfo  : SearchRec;
  606. begin
  607.   i := 1;
  608.   FindFirst(mask,Archive,dirinfo);
  609.   while (DosError=0) AND (i<MaxFiles+1) do
  610.     begin
  611.       FileList[i] := dirinfo.name;
  612.       FindNext(dirinfo);
  613.       i := i+1;
  614.     end;
  615.   NumFiles := i-1;
  616.   FileSort(FileList,NumFiles);
  617.   Get_File_Menu := Get_Files_Toggle(FileList,NumFiles,NumRows,Row,Col);
  618. end;
  619.  
  620. procedure ScrMenuType.Setup(MData : ScrMenuRec);
  621. var i : integer;
  622. begin
  623.   with MenuData do
  624.     for i := 1 to MaxChoices do
  625.       begin
  626.         selection[i] := MData.selection[i];
  627.         Descripts[i,1] := MData.descripts[i,1];
  628.         Descripts[i,2] := MData.descripts[i,2];
  629.         Descripts[i,3] := MData.descripts[i,3];
  630.       end;
  631. end;
  632.  
  633. function ScrMenuType.GetChoice : integer;
  634. var
  635.   i : integer;
  636.   Resp  : Response_Type;
  637.   Dir   : Movement;
  638.   KeyCh : char;
  639.  
  640. procedure PutDescripts;
  641. var i : integer;
  642. begin
  643.   window(0,0,79,24);
  644.   Solid_Box(3,21,79,24,lightgray);
  645.   for i := 1 to 3 do
  646.     Put_Colored_Text(MenuData.Descripts[last,i],20+i,4,white,lightgray);
  647. end;
  648.  
  649. begin
  650. with MenuData do
  651. begin
  652.   for i := 0 to NumChoices-1 do
  653.     Put_String(Selection[i+1],Line+i,Col,0);
  654.   Put_String(Selection[Last],Line+Last-1,Col,1);
  655.   Resp := No_Response;
  656.   while Resp <> Return do
  657.     begin
  658.       PutDescripts;
  659.       Get_Response(Resp,Dir,KeyCh);
  660.       case Resp of
  661.         Arrow :
  662.           if Dir = Up then
  663.             begin
  664.               Put_String(Selection[Last],Line+Last-1,Col,0);
  665.               if Last = 1 then
  666.                 Last := NumChoices
  667.               else
  668.                 Last := Last-1;
  669.               Put_String(Selection[Last],Line+Last-1,Col,1);
  670.             end
  671.           else if Dir = Down then
  672.             begin
  673.               Put_String(Selection[Last],Line+Last-1,Col,0);
  674.               if Last = NumChoices then
  675.                 Last := 1
  676.               else
  677.                 Last := Last+1;
  678.               Put_String(Selection[Last],Line+Last-1,Col,1);
  679.             end;
  680.         end;
  681.     end;
  682. end;
  683. end;
  684. { Initialization Area }
  685. begin
  686. end.
  687.